home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / textwndw.swg / 0011_Shadow Boxes.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-02  |  2.2 KB  |  107 lines
  1. { Updated SCREEN.SWG on November 2, 1993 }
  2.  
  3. {
  4. KIMBA DOUGHTY
  5.  
  6. > could someone tell me how to do a shadow Window.. you know the Type that
  7. > has a Window then a shadow of what is under the Window in color 8 or dark
  8. > gray... Either in Inline assembly or Straight Pascal...
  9. }
  10.  
  11. Unit shadow;
  12.  
  13. Interface
  14.  
  15. Uses
  16.   Crt, Dos;
  17.  
  18. Procedure WriteXY(X, Y : Integer; S : String);
  19. Function  GetCharXY(X, Y : Integer) : Char;
  20. Procedure SHADE(PX, PY, QX, QY : Integer);
  21. Procedure BOX(PX, PY, QX, QY : Integer);
  22. Procedure SHADOWBOX(PX, PY, QX, QY : Integer; fg, bg : Byte);
  23.  
  24. Implementation
  25.  
  26. Procedure menubox(x1, y1, x2, y2 : Integer; fg, bg : Byte);
  27. Var
  28.   count : Integer;
  29. begin
  30.   TextColor(fg);
  31.   TextBackGround(bg);
  32.   Writexy(x1 + 1, y1, '╔');
  33.  
  34.   For count := x1 + 2 to x2 - 2 do
  35.     Writexy(count, y1, '═');
  36.  
  37.   Writexy(x2 - 1, y1, '╗');
  38.   For count := y1 + 1 to y2 - 1 do
  39.     Writexy(x1 + 1, count, '║');
  40.  
  41.   Writexy(x1 + 1, y2, '╚');
  42.   For count := y1 + 1 to y2 - 1 do
  43.     Writexy(x2 - 1, count, '║');
  44.  
  45.   Writexy(x2 - 1, y2, '╝');
  46.   For count := x1 + 2 to x2 - 2 do
  47.     Writexy(count, y2, '═');
  48. end;
  49.  
  50. Procedure WriteXY(X, Y : Integer; S : String);
  51. Var
  52.   SX, SY : Integer ;
  53. begin
  54.   SX := WhereX;
  55.   SY := WhereY;
  56.   GotoXY(X, Y);
  57.   Write(S);
  58.   GotoXY(SX, SY);
  59. end;
  60.  
  61. Function GetCharXY(X, Y : Integer) : Char;
  62. Var
  63.   Regs : Registers;
  64.   SX, SY : Integer;
  65. begin
  66.   SX := WhereX;
  67.   SY := WhereY;
  68.   GotoXY(X, Y);
  69.   Regs.AH := $08;
  70.   Regs.BH := $00;
  71.   Intr($10, Regs);
  72.   GetCharXY := Char(Regs.AL);
  73.   GotoXY(SX, SY);
  74. end;
  75.  
  76. Procedure SHADE(PX, PY, QX, QY : Integer);
  77. Var
  78.   X, Y : Integer;
  79. begin
  80.   TextColor(8);
  81.   TextBackGround(black);
  82.   For Y := PY to QY Do
  83.   For X := PX to QX Do
  84.     WriteXY(X, Y, GetCharXY(X, Y));
  85. end;
  86.  
  87. Procedure BOX(PX, PY, QX, QY : Integer);
  88. begin
  89.   Window(PX, PY, QX, QY);
  90.   ClrScr;
  91. end;
  92.  
  93. Procedure SHADOWBOX(PX, PY, QX, QY: Integer; fg, bg : Byte);
  94. begin
  95.   TextColor(fg);
  96.   TextBackGround(bg);
  97.   BOX(PX, PY, QX, QY);
  98.   Window(1, 1, 80, 25);
  99.   SHADE(PX + 2, QY + 1, QX + 2, QY + 1);
  100.   SHADE(QX + 2, PY + 1, QX + 2, QY + 1);
  101.   SHADE(QX + 1, PY + 1, QX + 1, QY + 1);
  102.   MENUBOX(PX, PY, QX, QY, fg, bg);
  103. end;
  104.  
  105. end.
  106.  
  107.